home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / bbs / mfm_111b.zip / COPYMOVE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-01-07  |  18KB  |  470 lines
  1. {========================================================================}
  2. Procedure CenterWrite(Row : Byte; CenteredString : String);
  3.   Begin
  4.     AnsiGotoXY(Row,1); AnsiClearToEOL;
  5.     AnsiGotoXY(Row,40-(Length(CenteredString) Div 2));
  6.     Write(CenteredString);
  7.   End;
  8. {========================================================================}
  9. Function FileCopy(FromFileName, ToFileName : String; CopyOrMove : Char) : Boolean;
  10.   Var
  11.     FromFile, ToFile : File;
  12.     OverWrite : Boolean;
  13.     Fcc : Char;
  14.     TempEntry : ListPtr;
  15.     ToFilesBbs : Text;
  16.   Begin
  17.     FileCopy := False; OverWrite := True;
  18.     FindFirst(FromFileName,AnyFile,DirInfo);
  19.     If DosError = 0 Then
  20.     Begin
  21.       FindFirst(ToFileName,AnyFile,DirInfo);
  22.       If DosError = 0 Then
  23.       Begin
  24.         OverWrite := False;
  25.         AnsiClearScreen; AnsiGotoXY(21,1);
  26.         NewTextColor(Black); NewTextBackground(Cyan);
  27.         Write(Pgmid+'      ^Q=quit ?=help');
  28.         NewTextColor(White); NewTextBackground(Black);
  29.         NextPrintEntry := CurrentEntry; DisplayRecord(22);
  30.         NewTextColor(White);
  31.         CenterWrite(23,'already exists as');
  32.         New(TempEntry);
  33.         TempEntry^.TypeOfRecord := FileRecord;
  34.         TempEntry^.FileName := DirInfo.Name;
  35.         TempEntry^.FileDate := DirInfo.Time;
  36.         TempEntry^.FileSize := DirInfo.Size;
  37.         Fsplit(ToFileName,D,N,E);
  38.         Assign(ToFilesBbs,D+'FILES.BBS');
  39.         {$I-} Reset(ToFilesBbs); {$I+}
  40.         If IOresult = 0 Then
  41.         Begin
  42.           While (Not Eof(ToFilesBbs)) Do
  43.           Begin
  44.             ReadLn(ToFilesBbs,WorkString);
  45.             If Pos(N+E,WorkString) > 0 Then
  46.             Begin
  47.               TempEntry^.Description := Copy(WorkString,Pos(' ',WorkString)+1,Length(WorkString)-Pos(' ',WorkString));
  48.             End;
  49.           End;
  50.           Close(ToFilesBbs);
  51.         End
  52.         Else
  53.         Begin
  54.           TempEntry^.Description := '';
  55.         End;
  56.         TempEntry^.Tagged := False;
  57.         NextPrintEntry := TempEntry; DisplayRecord(24);
  58.         Dispose(TempEntry);
  59.         NewTextColor(White);
  60.         CenterWrite(25,'Overwrite? (Y/N) ');
  61.         Repeat
  62.           Gbx := GetInput;
  63.           Fcc := Upcase(Chr(Gbx));
  64.         Until Fcc In ['N','Y'];
  65.         Write(Fcc);
  66.         If Fcc = 'Y' Then OverWrite := True;
  67.       End;
  68.       If OverWrite Then
  69.       Begin
  70.         If (CopyOrMove = 'M') And (Copy(FromFileName,1,1) = Copy(ToFileName,1,1)) Then
  71.         Begin
  72.           CenterWrite(22,'Moving');
  73.           CenterWrite(23,FromFileName);
  74.           CenterWrite(24,'to');
  75.           CenterWrite(25,ToFileName);
  76.           FindFirst(ToFileName,AnyFile,DirInfo);
  77.           If DosError = 0 Then
  78.           Begin
  79.             Assign(ToFile,ToFileName);
  80.             Erase(ToFile);
  81.           End;
  82.           Assign(FromFile,FromFileName);
  83.           Rename(FromFile,ToFileName);
  84.         End
  85.         Else
  86.         Begin
  87.           If CopyOrMove = 'C' Then CenterWrite(22,'Copying ') Else CenterWrite(22,'Moving ');
  88.           CenterWrite(23,FromFileName);
  89.           CenterWrite(24,'to');
  90.           CenterWrite(25,ToFileName);
  91.           DoFileCopy(FromFileName,ToFileName);
  92.           Assign(FromFile,FromFileName);
  93.           If CopyOrMove = 'M' Then Erase(FromFile);
  94.         End;
  95.         FileCopy := True;
  96.       End;
  97.     End;
  98.   End;
  99. {========================================================================}
  100. Procedure ShowSizeSpace(Drive : Char; Row : Byte);
  101.   Begin
  102.     Drive := UpCase(Drive);
  103.     AnsiGotoXY(Row,1);
  104.     NewTextColor(Black);
  105.     NewTextBackground(Cyan);
  106.     AnsiClearToEol;
  107.     Write(CurrentEntry^.FileName+' is ',CurrentEntry^.FileSize Div 1024,'K bytes in size!   There are ');
  108.     Write(DiskFree(Ord(Drive)-64) Div 1024);
  109.     Write('K bytes free on drive '+Drive+'.');
  110.     NewTextColor(White); NewTextBackground(Black);
  111.   End;
  112. {========================================================================}
  113. Procedure CopyFile;
  114.   Var
  115.     ToAreaPath : String[80];
  116.     Cfc : Char;
  117.   Begin
  118.     If CurrentEntry^.TypeOfRecord = FileRecord Then
  119.     Begin
  120.       SetupScreen;
  121.       AnsiGotoXY(25,1); AnsiClearToEOL;
  122.       Write(FileAreaPath+CurrentEntry^.FileName);
  123.       ToAreaPath := ChooseArea;
  124.       If ToAreaPath <> 'QUIT' Then
  125.       Begin
  126.         ShowSizeSpace(ToAreaPath[1],24);
  127.         If CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64)-(SizeOfFilesBbs(ToAreaPath)+2048)) Then
  128.         Begin
  129.           ShowSizeSpace(ToAreaPath[1],21);
  130.           CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
  131.           CenterWrite(23,'to');
  132.           CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
  133.           CenterWrite(25,'Proceed with COPY? (Y/N) ');
  134.           Repeat
  135.             Gbx := GetInput;
  136.             Cfc := Upcase(Chr(Gbx));
  137.           Until Cfc In ['N','Y'];
  138.           Write(Cfc);
  139.           If Cfc = 'Y' Then
  140.           Begin
  141.             If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
  142.             Begin
  143.               FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  144.               If DosError = 0 Then
  145.               Begin
  146.                 Changed := False;
  147.                 Assign(FileList,ToAreaPath+'FILES.BBS');
  148.                 Reset(FileList);
  149.                 Assign(NewFileList,ToAreaPath+'FILES.MFM');
  150.                 Rewrite(NewFileList);
  151.                 While (Not Eof(FileList)) Do
  152.                 Begin
  153.                   ReadLn(FileList,WorkString);
  154.                   If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  155.                   Begin
  156.                     WriteLn(NewFileList,WorkString);
  157.                   End
  158.                   Else
  159.                   Begin
  160.                     WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  161.                     Changed := True;
  162.                   End;
  163.                 End;
  164.                 If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  165.                 Close(FileList); Close(NewFileList);
  166.                 Mfm2Bbs2Bak(ToAreaPath);
  167.               End
  168.               Else
  169.               Begin
  170.                 Assign(FileList,ToAreaPath+'FILES.MFM');
  171.                 ReWrite(FileList);
  172.                 WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  173.                 Close(FileList);
  174.                 Mfm2Bbs2Bak(ToAreaPath);
  175.               End;
  176.             End;
  177.           End;
  178.           ReDrawScreen;
  179.         End
  180.         Else
  181.         Begin
  182.           ReDrawScreen;
  183.           AnsiGotoXY(25,1); AnsiClearToEOL;
  184.           Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
  185.         End;
  186.       End
  187.       Else ReDrawScreen;
  188.     End;
  189.   End;
  190. {========================================================================}
  191. Procedure MoveFile;
  192.   Var
  193.     ToAreaPath : String[80];
  194.     Mfc : Char;
  195.     FileToErase : File;
  196.   Begin
  197.     If CurrentEntry^.TypeOfRecord = FileRecord Then
  198.     Begin
  199.       SetupScreen;
  200.       AnsiGotoXY(25,1); AnsiClearToEOL;
  201.       Write(FileAreaPath+CurrentEntry^.FileName);
  202.       ToAreaPath := ChooseArea;
  203.       If ToAreaPath <> 'QUIT' Then
  204.       Begin
  205.         ShowSizeSpace(ToAreaPath[1],24);
  206.         If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  207.           Or (FileAreaPath[1] = ToAreaPath[1]) Then
  208.         Begin
  209.           ShowSizeSpace(ToAreaPath[1],21);
  210.           CenterWrite(22,FileAreaPath+CurrentEntry^.FileName);
  211.           CenterWrite(23,'to');
  212.           CenterWrite(24,ToAreaPath+CurrentEntry^.FileName);
  213.           CenterWrite(25,'Proceed with MOVE? (Y/N) ');
  214.           Repeat
  215.             Gbx := GetInput;
  216.             Mfc := Upcase(Chr(Gbx));
  217.           Until Mfc In ['N','Y'];
  218.           Write(Mfc);
  219.           If Mfc = 'Y' Then
  220.           Begin
  221.             If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
  222.             Begin
  223.               FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  224.               If DosError = 0 Then
  225.               Begin
  226.                 Changed := False;
  227.                 Assign(FileList,ToAreaPath+'FILES.BBS');
  228.                 Reset(FileList);
  229.                 Assign(NewFileList,ToAreaPath+'FILES.MFM');
  230.                 Rewrite(NewFileList);
  231.                 While (Not Eof(FileList)) Do
  232.                 Begin
  233.                   ReadLn(FileList,WorkString);
  234.                   If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  235.                   Begin
  236.                     WriteLn(NewFileList,WorkString);
  237.                   End
  238.                   Else
  239.                   Begin
  240.                     WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  241.                     Changed := True;
  242.                   End;
  243.                 End;
  244.                 If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  245.                 Close(FileList); Close(NewFileList);
  246.                 Mfm2Bbs2Bak(ToAreaPath);
  247.               End
  248.               Else
  249.               Begin
  250.                 Assign(FileList,ToAreaPath+'FILES.MFM');
  251.                 ReWrite(FileList);
  252.                 WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  253.                 Close(FileList);
  254.                 Mfm2Bbs2Bak(ToAreaPath);
  255.               End;
  256.               PushRecord(KillEntry);
  257.               OldEntry := KillEntry;
  258.               If KillEntry^.PrevEntry = KillEntry Then
  259.               Begin
  260.                 Dispose(KillEntry);
  261.                 KillEntry := NIL;
  262.               End
  263.               Else
  264.               Begin
  265.                 KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  266.                 KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  267.                 KillEntry := KillEntry^.NextEntry;
  268.               End;
  269.               If KillEntry <> NIL Then Dispose(OldEntry);
  270.             End;
  271.           End;
  272.           ReDrawScreen;
  273.         End
  274.         Else
  275.         Begin
  276.           ReDrawScreen;
  277.           AnsiGotoXY(25,1); AnsiClearToEOL;
  278.           Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
  279.         End;
  280.       End
  281.       Else ReDrawScreen;
  282.     End;
  283.   End;
  284. {========================================================================}
  285. Procedure MassMove;
  286.   Var
  287.     ToAreaPath : String[80];
  288.     TempEntry : ListPtr;
  289.     Mmc : Char;
  290.     MoveOk : Boolean;
  291.   Begin
  292.     SetupScreen;
  293.     CenterWrite(25,'Select area to MASS MOVE to...');
  294.     ToAreaPath := ChooseArea;
  295.     If ToAreaPath <> 'QUIT' Then
  296.     Begin
  297.       CenterWrite(25,'Proceed with MASS MOVE? (Y/N) ');
  298.       Repeat
  299.         Gbx := GetInput;
  300.         Mmc := Upcase(Chr(Gbx));
  301.       Until Mmc In ['N','Y'];
  302.       Write(Mmc);
  303.       If Mmc = 'Y' Then
  304.       Begin
  305.         TempEntry := CurrentEntry;
  306.         CurrentEntry := FirstEntry;
  307.         While CurrentEntry^.NextEntry <> NIL Do
  308.         Begin
  309.           MoveOk := False;
  310.           If CurrentEntry^.Tagged Then
  311.           Begin
  312.             ShowSizeSpace(ToAreaPath[1],24);
  313.             If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  314.               Or (FileAreaPath[1] = ToAreaPath[1]) Then
  315.             Begin
  316.               ShowSizeSpace(ToAreaPath[1],21);
  317.               If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'M') Then
  318.               Begin
  319.                 FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  320.                 If DosError = 0 Then
  321.                 Begin
  322.                   Changed := False;
  323.                   Assign(FileList,ToAreaPath+'FILES.BBS');
  324.                   Reset(FileList);
  325.                   Assign(NewFileList,ToAreaPath+'FILES.MFM');
  326.                   Rewrite(NewFileList);
  327.                   While (Not Eof(FileList)) Do
  328.                   Begin
  329.                     ReadLn(FileList,WorkString);
  330.                     If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  331.                     Begin
  332.                       WriteLn(NewFileList,WorkString);
  333.                     End
  334.                     Else
  335.                     Begin
  336.                       WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  337.                       Changed := True;
  338.                     End;
  339.                   End;
  340.                   If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  341.                   Close(FileList); Close(NewFileList);
  342.                   Mfm2Bbs2Bak(ToAreaPath);
  343.                 End
  344.                 Else
  345.                 Begin
  346.                   Assign(FileList,ToAreaPath+'FILES.MFM');
  347.                   ReWrite(FileList);
  348.                   WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  349.                   Close(FileList);
  350.                   Mfm2Bbs2Bak(ToAreaPath);
  351.                 End;
  352.                 MoveOk := True;
  353.                 PushRecord(KillEntry);
  354.                 OldEntry := KillEntry;
  355.                 If KillEntry^.PrevEntry = KillEntry Then
  356.                 Begin
  357.                   Dispose(KillEntry);
  358.                   KillEntry := NIL;
  359.                 End
  360.                 Else
  361.                 Begin
  362.                   KillEntry^.PrevEntry^.NextEntry := KillEntry^.NextEntry;
  363.                   KillEntry^.NextEntry^.PrevEntry := KillEntry^.PrevEntry;
  364.                   KillEntry := KillEntry^.NextEntry;
  365.                 End;
  366.                 If KillEntry <> NIL Then Dispose(OldEntry);
  367.               End;
  368.             End
  369.             Else
  370.             Begin
  371.               ReDrawScreen;
  372.               AnsiGotoXY(25,1); AnsiClearToEOL;
  373.               Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the move!');
  374.             End;
  375.           End;
  376.           If (Not MoveOk) Then CurrentEntry := CurrentEntry^.NextEntry;
  377.         End;
  378.       End;
  379.     End;
  380.     CurrentEntry := TopEntry; Row := 1;
  381.     SetupScreen; DisplayScreen;
  382.   End;
  383. {========================================================================}
  384. Procedure MassCopy;
  385.   Var
  386.     ToAreaPath : String[80];
  387.     TempEntry : ListPtr;
  388.     Mcc : Char;
  389.     CopyOk : Boolean;
  390.   Begin
  391.     SetupScreen;
  392.     CenterWrite(25,'Select area to MASS COPY to...');
  393.     ToAreaPath := ChooseArea;
  394.     If ToAreaPath <> 'QUIT' Then
  395.     Begin
  396.       CenterWrite(25,'Proceed with MASS COPY? (Y/N) ');
  397.       Repeat
  398.         Gbx := GetInput;
  399.         Mcc := Upcase(Chr(Gbx));
  400.       Until Mcc In ['N','Y'];
  401.       Write(Mcc);
  402.       If Mcc = 'Y' Then
  403.       Begin
  404.         TempEntry := CurrentEntry;
  405.         CurrentEntry := FirstEntry;
  406.         While CurrentEntry^.NextEntry <> NIL Do
  407.         Begin
  408.           CopyOk := False;
  409.           If CurrentEntry^.Tagged Then
  410.           Begin
  411.             ShowSizeSpace(ToAreaPath[1],24);
  412.             If (CurrentEntry^.FileSize < (DiskFree(Ord(UpCase(ToAreaPath[1]))-64))-(SizeOfFilesBbs(ToAreaPath)+2048))
  413.               Or (FileAreaPath[1] = ToAreaPath[1]) Then
  414.             Begin
  415.               ShowSizeSpace(ToAreaPath[1],21);
  416.               If FileCopy(FileAreaPath+CurrentEntry^.FileName,ToAreaPath+CurrentEntry^.FileName,'C') Then
  417.               Begin
  418.                 FindFirst(ToAreaPath+'FILES.BBS',AnyFile,DirInfo);
  419.                 If DosError = 0 Then
  420.                 Begin
  421.                   Changed := False;
  422.                   Assign(FileList,ToAreaPath+'FILES.BBS');
  423.                   Reset(FileList);
  424.                   Assign(NewFileList,ToAreaPath+'FILES.MFM');
  425.                   Rewrite(NewFileList);
  426.                   While (Not Eof(FileList)) Do
  427.                   Begin
  428.                     ReadLn(FileList,WorkString);
  429.                     If Pos(CurrentEntry^.FileName,WorkString) = 0 Then
  430.                     Begin
  431.                       WriteLn(NewFileList,WorkString);
  432.                     End
  433.                     Else
  434.                     Begin
  435.                       WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  436.                       Changed := True;
  437.                     End;
  438.                   End;
  439.                   If (Not Changed) Then WriteLn(NewFileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  440.                   Close(FileList); Close(NewFileList);
  441.                   Mfm2Bbs2Bak(ToAreaPath);
  442.                 End
  443.                 Else
  444.                 Begin
  445.                   Assign(FileList,ToAreaPath+'FILES.MFM');
  446.                   ReWrite(FileList);
  447.                   WriteLn(FileList,CurrentEntry^.FileName+' '+CurrentEntry^.Description);
  448.                   Close(FileList);
  449.                   Mfm2Bbs2Bak(ToAreaPath);
  450.                 End;
  451.                 CopyOk := True;
  452.               End;
  453.             End
  454.             Else
  455.             Begin
  456.               ReDrawScreen;
  457.               AnsiGotoXY(25,1); AnsiClearToEOL;
  458.               Write('There is not enough space on drive '+ToAreaPath[1]+' to complete the copy!');
  459.             End;
  460.           End;
  461.           CurrentEntry^.Tagged := False;
  462.           If (Not CopyOk) Then CurrentEntry := CurrentEntry^.NextEntry;
  463.         End;
  464.       End;
  465.     End;
  466.     CurrentEntry := TopEntry; Row := 1;
  467.     SetupScreen; DisplayScreen;
  468.   End;
  469. {========================================================================}
  470.